perm filename LIBMAC.SCO[PAS,SYS] blob
sn#452531 filedate 1979-06-30 generic text, type T, neo UTF8
;
; (C) COPYRIGHT 1978, 1979
; BOARD OF TRUSTEES
; LELAND STANFORD JUNIOR UNIVERSITY
; STANFORD, CA. 94305, U. S. A.
;
; (C) COPYRIGHT 1978, 1979
; ARMANDO R. RODRIGUEZ
; LOTS COMPUTER FACILITY
; STANFORD UNIVERSITY
; STANFORD, CA. 94305, U. S. A.
;
;
; (C) COPYRIGHT H.-H. NAGEL
; INSTITUT FUER INFORMATIK
; DER UNIVERSITAET HAMBURG
; SCHLUETERSTRASSE 70
; 2000 HAMBURG 13
; GERMANY
; 1976
;
;*** PASCAL RUNTIME PROGRAM LIBRARY (18-AUG-76, KISICKI)
;
;*** DICTIONARY ***
;
;PAGE1 : DICTIONARY
;PAGE2 : FREE FREE
;PAGE3 : EXPO EXPO
;PAGE4 : ROUND ROUND
;PAGE5 : RUNPGM RUNPGM
;PAGE6 : WRTSTR WRTPS1 WRTPST WRTUS1 WRTUST
;PAGE7 : NEW NEW
;PAGE8 : READC READC
;PAGE9 : WRTOCT WRTOC1 WRTOCT
;PAGE10 : WRTHEX WRTHEX WRTHX1
;PAGE11 : WRTBOL WRTBO1 WRTBOL
;PAGE12 : READR READR
;PAGE13 : TRUNC TRUNC
;PAGE14 : INTREA INTREA
;PAGE15 : WRITEC WRITC1 WRITEC
;PAGE16 : WRTREA WRTRE1 WRTRE2 WRTREA
;PAGE17 : WRTINT WRTIN1 WRTINT
;PAGE18 : READI READI
;PAGE19 : TTYOPN TTYOPN
;PAGE20 : OPEN RESETF REWRIT TMPBLK
;PAGE21 : REASTR READPS READS
;PAGE22 : CLOSE CLSFIL
;PAGE23 : PUT PUT PUTBUF PUTCH PUTLN PUTPG TMPCR1 TMPCRW
;PAGE24 : GET GET GETBUF GETCH GETLN
;PAGE25 : DATE DATE DATE.
;PAGE26 : TIME TIME TIME.
;PAGE27 : EXIT CONERR CORERR END INXERR IPTERR NOCORE OVERF. PTRERR PUTERR SETERR SRERR STOP WRTPC
;PAGE28 : DEBSP EXDEB. INDEB.
;PAGE29 : WRTFNM WRTFNM WRTSIX
;PAGE30 : TMPTST TMPTST
;PAGE31 : ASTOSX ASTOSX
;PAGE32 : REAAUX GETINT GETSGN RTEST
;PAGE33 : SETEOF SETEOF
;PAGE34 : WRTAUX TOOSML WRTBLK WRTOPN WRTSGN
;PAGE35 : FORER. FORER.
;PAGE36 : FORPAS PUTADR LOCATI JUMPTO
TITLE FREE *** PROCEDURE FREE ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY FREE
;
;*** EXTERNAL-REFERENCES ***
;
EXTERN WRTPC
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** ADDRESSES
;
.JBSA= 120
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** PROCEDURE FREE
; - RESET NEWREG
; - <AC0>=VARIABLE TO BE RETAINED
; - AC1=LENGTH OF VARIABLE
;
FREE: CAIGE AC0 ,(NEWREG) ;A(VAR) >= NEWREG
JRST FREERR ;NO - INVALID ARG TO FREE
ADD AC0 ,AC1 ;NEW POSITION
HLRZ AC1 ,.JBSA ;NEW POS.
CAIL AC0 ,(AC1) ;< .JBSA
JRST FREERR ;NO - INVALID ARG TO FREE
HRRZ NEWREG ,AC0 ;RESET NEWREG
POPJ TOPP , ;RET TO CALLER
FREERR: OUTSTR [ASCIZ/
%? POINTER OUT OF BOUNDS: CANNOT RETAIN VARIABLE/]
JRST WRTPC
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE EXPO *** FUNCTION EXPO ***
TWOSEG
;
;*** ENTRY-POINTS
;
ENTRY EXPO
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** FUNCTION EXPO
; - RETURN THE EXPONENT OF A REAL VALUE
; - REG=REAL VALUE
; - 1(TOPP):=EXPONENT AS INTEGER
;
EXPO: JUMPGE REG ,.+2 ;POS. ARG.?
MOVM REG ,REG ;GET MAGNITUDE IF NOT
LDB REG ,[POINT 8,REG,8] ;GET EXPONENT
SUBI REG ,200 ;200 FOR EXPONENT
MOVEM REG ,1(TOPP) ;STORE FUNCTION RESULT
POPJ TOPP ,
;
;*** LITERALS
;
LIT
PRGEND
TITLE ROUND *** FUNCTION ROUND ***
TWOSEG
;
;*** ENTRY-POINTS
;
ENTRY ROUND
;
;*** EXTERNAL REFERENCES
;
EXTERN TRUNC
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** FUNCTION ROUND
; - ROUND REAL VALUE TO NEAREST INTEGER
; - REG=REAL VALUE
; - 1(TOPP):=TRUNC(REG + 0.5)
;
ROUND: FADR REG ,[0.5] ;GET ARG. FOR TRUNC
PUSH TOPP ,REG1 ;SAVE REG1
MOVEI REG1 ,0 ;2ND ARG. FOR TRUNC
PUSHJ TOPP ,TRUNC ;CALL TRUNC
MOVE REG ,2(TOPP) ;GET RESULT FROM TRUNC
POP TOPP ,REG1 ;RESTORE REG1
MOVEM REG ,1(TOPP) ;STORE FUNCTION RESULT
POPJ TOPP , ;RETURN TO CALLER
;
;*** LITERALS
;
LIT
PRGEND
TITLE RUNPGM *** PROCEDURE RUN ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY RUNPGM
;
;*** EXTERNAL REFERENCES ***
;
EXTERN ASTOSX
EXTERN WRTSIX
EXTERN WRTPC
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF VARIANT CODE ***
;
RUNBLK: SIXBIT / /
SIXBIT / /
SIXBIT / /
XWD 0 ,0
XWD 0 ,0
XWD 0 ,0
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE RUN
; - ISSUE RUN-UUO
; - <REG>=ASCII/9 CHAR. FILENAME/
; - <REG1>=ASCII/6 CHAR. DEVICE/
; - REG2=PROJ.-PROG.-NR.
; - REG3=CORE REQUIREMENT
;
RUNPGM: MOVE AC0 ,[SIXBIT/SYS /] ;ASSUME
MOVEM AC0 ,RUNBLK ;SYS
JUMPE REG1 ,NODEV ;DEVICE?
MOVEI REG5 ,6 ;YES, SET LENGTH
MOVEI AC1 ,RUNBLK
PUSHJ TOPP ,ASTOSX ;AND CONV. TO SIXBIT
NODEV: HRRI REG1 ,(REG) ;ADDR OF FILENAME
MOVEI AC1 ,RUNBLK+1
MOVEI REG5 ,6
PUSHJ TOPP ,ASTOSX ;CONV. FILEN. TO SIXBIT
MOVEM REG2 ,RUNBLK+4
IMULI REG3 ,2000
HRRZM REG3 ,RUNBLK+5
HRLI AC1 ,1
HRRI AC1 ,RUNBLK
RUN AC1 , ;RUN SPECIFIED PROGRAM
RUNERR: OUTSTR [ASCIZ/
%? CANNOT RUN /]
MOVEI REG1 ,RUNBLK+1 ;PROGRAM'S NAME
PUSHJ TOPP ,WRTSIX ;WRITE OUT NAME
JRST WRTPC
;
;*** LITERALS
;
LIT
PRGEND
TITLE WRTSTR *** PROCEDURES WRTPST AND WRTUST ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTPST
ENTRY WRTUST
ENTRY WRTPS1
ENTRY WRTUS1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTPST/WRTUST
; - WRITE PACKED STRING/STRING
; - <REG1>=STRING
; - REG2=TOTAL LENGTH OF OUTPUT
; - REG3=LENGTH OF STRING
;
WRTPS1: MOVE REG2 ,REG3 ;DEFAULT LENGTH
JRST WRTPST
WRTUS1: MOVE REG2 ,REG3 ;DEFAULT LENGTH
JRST WRTUST
WRTPST: HRLI REG1 ,440700 ;WRITE PACKED STRING
JRST BLANK-1
WRTUST: HRLI REG1 ,444400
JUMPLE REG2 ,WRTRET ;FIELDWIDTH = 0 ?
BLANK: CAIG REG2 ,(REG3) ;LEADING BLANKS REQUESTED ?
JRST START ;NO
MOVEI AC0 ," "
PUSHJ TOPP ,PUTCH
SOJA REG2 ,BLANK ;MORE LEADING BLANKS ?
START: ILDB AC0 ,REG1
PUSHJ TOPP ,PUTCH
SOJG REG2 ,START ;ANY CHARACTER LEFT ?
WRTRET: POPJ TOPP , ;NO - RETURN
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE NEW *** PROCEDURE NEW ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY NEW
;
;*** EXTERNAL REFERENCES ***
;
EXTERN WRTPC
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE NEW
; - ALLOCATE DYNAMIC VARIABLES
; - REG=LENGTH OF VARIABLE
; - <REG>:=VARIABLE
;
NEW: SUB NEWREG ,REG ;UPDATE NEWREG
CAIL NEWREG ,40(TOPP) ;40 LOCATIONS TO ACCOUNT FOR
;USE OF STACK BY RUNTIME SUPPORT
JRST ALLOC ;OK - ALLOCATE STORAGE
ADDI NEWREG ,(REG) ;RESET NEWREG ON OVERRUN
JRST NEWERR
ALLOC: HRR AC1 ,NEWREG
MOVN REG ,REG
HRL AC1 ,REG
CLEAR: SETZM (AC1) ;SET REQUESTED
AOBJN AC1 ,CLEAR ;STORAGE TO ZERO
MOVE REG ,NEWREG ;RETURN ADDR OF VARIABLE
POPJ TOPP ,
NEWERR: OUTSTR [ASCIZ/
%? HEAP OVERRUNS STACK: RETRY WITH MORE CORE/]
JRST WRTPC
;
;*** LITERALS
;
LIT
PRGEND
TITLE READC *** PROCEDURE READC ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY READC
;
;*** EXTERNAL REFERENCES ***
;
EXTERN GETCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE READC
; - READ SINGLE CHARACTER
; - <REG1>=CHAR
;
READC: MOVE AC0 ,FILCMP(REG)
MOVEM AC0 ,(REG1)
PUSHJ TOPP ,GETCH
POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE WRTOCT *** PROCEDURE WRTOCT ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTOCT
ENTRY WRTOC1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTOCT
; - WRITE OCTAL FORMAT
; - REG1=OCTAL NUMBER
; - REG2=TOTAL LENGTH OF OUTPUT
;
WRTOC1: HRRZI REG2 ,14 ;DEFAULT LENGTH 12
JRST OCTEST
WRTOCT: JUMPLE REG2 ,OCTRET ;FIELDWIDTH = 0 ?
WRTOIN: CAIG REG2 ,14 ;LEAD. BLKS. REQ.?
JRST OCTEST ;NO
MOVEI AC0 ," "
PUSHJ TOPP ,PUTCH
SOJA REG2 ,WRTOIN ;MORE BLANKS TO BE INSERTED ?
OCTEST: MOVE REG3 ,[POINT 3,REG1]
HRREI AC1 ,-14(REG2)
JUMPE AC1 ,OCTWRT ;LESS THAN 12 POSITIONS REQUIRED ?
IBP REG3 ;YES
AOJL AC1 ,.-1
OCTWRT: ILDB AC0 ,REG3 ;GET DIGIT
ADDI AC0 ,60 ;CONVERT TO ASCII
PUSHJ TOPP ,PUTCH
SOJG REG2 ,OCTWRT ;MORE DIGITS TO BE OUTPUT ?
OCTRET: POPJ TOPP , ;NO - RETURN
;
;*** LITERALS
;
LIT
PRGEND
TITLE WRTHEX *** PROCEDURE WRTHEX ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTHEX
ENTRY WRTHX1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTHEX
; - WRITE SEDECIMAL NUMBER
; - REG1=HEXADECIMAL NUMBER
; - REG2=TOTAL LENGHT OF OUTPUT
;
WRTHX1: HRRZI REG2 ,11 ;DEFAULT LENGTH 9
JRST HEXTST
WRTHEX: JUMPLE REG2 ,HEXRET ;FIELD = 0?
WRTHIN: CAIG REG2 ,11 ;LEADING BLANKS REQUIRED?
JRST HEXTST ;NO
MOVEI AC0 ," "
PUSHJ TOPP ,PUTCH
SOJA REG2 ,WRTHIN
HEXTST: MOVE REG3 ,[POINT 4,REG1]
HRREI AC1 ,-11(REG2)
JUMPE AC1 ,HEXWRT ;LESS THEN 11 POSITIONS
IBP REG3 ;YES
AOJL AC1 ,.-1
HEXWRT: ILDB AC0 ,REG3
ADDI AC0 ,60
CAIL AC0 ,72 ;DIGIT?
ADDI AC0 ,7 ;NO LETTER
PUSHJ TOPP ,PUTCH
SOJG REG2 ,HEXWRT
HEXRET: POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE WRTBOL *** PROCEDURE WRTBOL ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTBOL
ENTRY WRTBO1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
EXTERN WRTBLK
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTBOL
; - WRITE BOOLEAN CONSTANT
; - REG1=BOOLEAN VARIABLE
; - REG2=TOTAL LENGTH OF OUTPUT
;
WRTBO1: HRRZI REG2 ,1 ;DEFAULT LENGTH 5
JRST BLANK
WRTBOL: CAIGE REG2 ,5 ;FORMAT GREATER OR EQUAL FIVE ?
JRST BSMALL ;NO - SMALL OUTPUT
SUBI REG2 ,5
BLANK: PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS IF ANY
MOVEI REG2 ,5 ;FIVE CHARACTERS ARE GIVEN OUT
MOVE REG3 ,[ASCII/FALSE/]
SKIPE REG1 ;TRUE OR FALSE? - SKIP IF FALSE
MOVE REG3 ,[ASCII/ TRUE/]
MOVE REG1 ,[POINT 7,REG3,-1]
ILDB AC0 ,REG1 ;GETS CHARACTER
PUSHJ TOPP ,PUTCH
SOJG REG2 ,.-2 ;MORE CHARACTERS?
POPJ TOPP , ;NO - RETURN
BSMALL: JUMPE REG2 ,BOLEND ;FIELDWIDTH = 0?
SUBI REG2 ,1
PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS IF ANY
MOVEI AC0 ,"F"
SKIPE REG1 ;TRUE OR FALSE? - SKIP IF FALSE
MOVEI AC0 ,"T"
PUSHJ TOPP ,PUTCH
BOLEND: POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE READR *** PROCEDURE READR ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY READR
;
;*** EXTERNAL REFERENCES ***
;
;
EXTERN GETCH
EXTERN CONERR
EXTERN READI
EXTERN INTREA
EXTERN GETINT
EXTERN GETSGN
EXTERN RTEST
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE READR
; - READ REAL FORMAT
; - <REG1>=REAL VALUE
; - REG2=TOTAL LENGTH OF OUTPUT
; - REG3=LENGTH OF FRACTION
;
READR: PUSHJ TOPP ,GETSGN ;GETS SIGN IF ANY AND FIRST COMPONET
;TO AC0
PUSHJ TOPP ,RTEST ;TEST IF FIRST COMPONENT IN DIGITS
;IF NOT ERROR - MESSAGE AND EXIT
PUSHJ TOPP ,GETINT ;GETS INTEGER BEFORE POINT TO REG2
MOVEI AC1 ,REG2 ;CONVERTS TO ASCII
PUSHJ TOPP ,INTREA
MOVE REG4 ,REG2 ;FURTHER WORKING FOR REAL ON REG4
SETZ REG6 , ;FOR DECIMAL EXPONENT
MOVE AC0 ,FILCMP(REG)
CAIE AC0 ,"." ;NOW HAS TO COME DECIMAL POINT
JRST CONERR ;NO POINT - ERROR MESSAGE AND EXIT
BEHPNT: SKIPE FILEOL(REG)
JRST REXP
PUSHJ TOPP ,GETCH
MOVE AC0 ,FILCMP(REG) ;GET NEXT COMPONENT
CAIG AC0 ,"9" ;IN DIGITS ?
CAIGE AC0 ,"0"
JRST REXP ;NO
SOJ REG6 , ;INCREMENT EXPONENT
FMPR REG4 ,[10.0]
SUBI AC0 ,"0" ;CONVERTS ASCII TO INTEGER
FSC AC0 ,233 ;CONVERTS INTEGER TO REAL
FADR REG4 ,AC0 ;ADD NEW DIGIT TO REST
JRST BEHPNT ;GET NEXT DIGITS IF ANY
REXP: SKIPL REG6 ;ONE OR MORE DIGITS BEHIND POINT ?
JRST CONERR ;NO - WRITE ERROR MESSAGE AND RETURN
MOVEI REG5 ,(REG3) ;SAVES SIGN
CAIE AC0 ,"E" ;DIGIT EQUAL E ?
JRST .+5 ;NO
SKIPN FILEOL(REG)
PUSHJ TOPP ,GETCH ;GET NEXT COMPONENT
PUSHJ TOPP ,READI ;GETS EXPONENT TO REG2
ADD REG6 ,REG2
JUMPL REG6 ,REXP1
SOJL REG6 ,REAOUT ;DEXIMAL EXPONENT EQUAL 0?
FMPR REG4 ,[10.0] ;NO - TOO LARGE - DIVIDIDE REAL VALUE
JRST .-2
REXP1: FDVR REG4 ,[10.0] ;NO - TOO SMALL - MULTIPLY REAL VALUE
AOJL REG6 ,.-1
REAOUT: JFCL 10 ,CONERR ;OVERFLOW - BIT SET ?
;IF SET JUMP TO CONERR
SKIPE REG5 ;SIGN EQUAL PLUS ?
MOVN REG4 ,REG4 ;NO - NEGATE REAL VALUE
MOVEM REG4 ,(REG1) ;STORE VALUE INTO VARIABLE
POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE TRUNC *** FUNCTION TRUNC ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY TRUNC
;
;*** EXTERNAL REFERENCES ***
;
EXTERN INTREA
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** FUNCTION TRUNC
; - CONVERT REAL TO INTEGER
; - REG=REAL VALUE
; - 1(TOPP):=[REG] AS INTEGER
;
TRUNC: SETZM 1(TOPP) ;CLEARS SIGN BIT
MOVE AC0 ,REG
JUMPGE AC0 ,POSVAL ;NEGATIVE NUMBER ?
AOS 1(TOPP) ;YES - SET SIGN BIT
MOVM AC0 ,AC0 ;MAKE IT POSITIVE
POSVAL: LDB REG ,[POINT 8,AC0,8] ;GETS EXPONENT
TLZ AC0 ,377000 ;RESET EXPONENT TO ZERO
SUBI REG ,233 ;200 FOR OFFSET, 33 FOR MANTISSE
SETZ AC1 , ;CLEAR AC1
ASHC AC0 ,(REG) ;AC0 := AC0 * 2 ** REG
SKIPN 1(TOPP) ;NEGATIVE SIGN ?
JRST READY ;NO - OVERJUMP
SKIPE AC1 ;REST EQUAL ZERO ?
AOS AC0 ;NO - INCREMENT
MOVN AC0 ,AC0 ;AND MAKE NEGATIVE
READY: MOVEM AC0 ,1(TOPP) ;STORE FUNCTION RESULT
POPJ TOPP , ;RETURN TO CALLER
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE INTREA *** FUNCTION INTREA ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY INTREA
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** FUNCTION INTREA
; - CONVERT INTEGER TO REAL
; - <AC1>=INTEGER VALUE
; - <AC1>:=<AC1> AS REAL
;
INTREA: MOVE AC0 ,(AC1) ;GETS INTEGER TO AC0
JUMPGE AC0 ,.+3 ;VALUE NEGATIVE ?
TLO AC1 ,400000 ;SETS SIGN BIT
MOVM AC0 ,AC0 ;AC0 := ABS(AC0)
MOVEM AC1 ,1(TOPP) ;SAVES ADRESS AND SIGN BIT
JFFO AC0 ,.+2 ;WHERE IS THE FIRST "ONE"?
JRST .+7 ;AC0 CONTAINS ONLY ZERO'S
SUBI AC1 ,11 ;AC1 := NR OF LEADING 0'S - 9
JUMPGE AC1 ,.+4 ;BITS OF EXPONENT EQUAL ZERO ?
LSH AC0 ,(AC1) ;NO - SET ZERO
MOVM AC1 ,AC1 ;AND INCREMENT EXPONENT BY COUNT
JRST .+2
SETZ AC1 ,
ADDI AC1 ,233 ;AC1 CONTAINS UNNORMALIZED EXPONENT
FSC AC0 ,(AC1) ;CONVERTS TO NORMALIESRD REAL
MOVE AC1 ,1(TOPP) ;GETS SIGN BIT AND ADDRESS
SKIPGE AC1 ;SIGN BIT SET ?
MOVN AC0 ,AC0 ;YES - NEGATE REAL VALUE
MOVEM AC0 ,(AC1) ;STORE FUNCTION RESULT
POPJ TOPP , ;RETURN
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE WRITEC *** PROCEDURE WRITEC ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRITEC
ENTRY WRITC1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRITEC
; - WRITE A SINGLE CHAR
; - REG1=CHAR
; - REG2=NUMBER OF LEAD. BLANKS
;
WRITC1: HRRZI REG2 ,1 ;DEFAULT LENGTH 1
WRITEC: JUMPLE REG2 ,WRITRT ;FIELDWIDTH = 0 ?
SOJE REG2 ,PRINT ;LEADING BLANKS REQUESTED ?
LOOP: MOVEI AC0 ," " ;YES
PUSHJ TOPP ,PUTCH
SOJG REG2 ,LOOP ;MORE LEADING BLANKS ?
PRINT: MOVE AC0 ,REG1 ;CHAR TO BE OUTPUT INTO AC0
PUSHJ TOPP ,PUTCH
WRITRT: POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE WRTREA *** PROCEDURE WRTREA ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTREA
ENTRY WRTRE1
ENTRY WRTRE2
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
EXTERN WRTOPN
EXTERN WRTSGN
EXTERN WRTOPN
EXTERN TOOSML
EXTERN WRTBLK
EXTERN WRTINT
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTREA
; - WRITE REAL FORMAT
; - REG1=REAL VALUE
; - REG2=TOTAL LENGTH OF OUTPUT
; - REG3=LENGTH OF FRACTION
;
WRTRE2: HRRZI REG2 ,20 ;DEFAULT LENGTH 16
WRTRE1: HRRZI REG3 ,123456 ;DEFAULT FLOATING REAL
JRST WRTREA
WRTMAT: SOJL REG5 ,.+4 ;MORE LEADING ZERO'S REQUEST
MOVEI AC0 ,"0" ;YES - WRITE THEM OUT
PUSHJ TOPP ,PUTCH
SOJG REG4 ,.-3 ;MORE LEADING ZERO'S BEFORE POINT ?
JUMPLE REG4 ,MATEND ;NO - MORE DIGITS BEFORE POINT ?
JUMPE REG1 ,.+7 ;MANTISSE EQUAL ZERO ?
LDB AC0 ,[POINT 9,REG1,8] ;NO - GET NEXT DIGIT
TLZ REG1 ,777000 ;RESETZ THIS BITS
IMULI REG1 ,12
ADDI AC0 ,"0" ;CONVERTS THEM TO ASCII
PUSHJ TOPP ,PUTCH
SOJG REG4 ,.-6 ;MORE DIGITS BEFORE POINT FROM REG1 ?
JUMPLE REG4 ,MATEND ;NO - MORE DIGITS BEFORE POINT ?
MOVEI AC0 ,"0" ;YES - WRITES ONE ZERO OUT
PUSHJ TOPP ,PUTCH
SOJG REG4 ,.-1
MATEND: POPJ TOPP ,
WRTREA: JUMPLE REG2 ,REARET ;FIELDWIDTH = 0?
PUSHJ TOPP ,WRTOPN ;SETS SIGN BIT AND PUTS FIELDWIDTH TO
; REG5
SETZ REG6 , ;TO SAVE DECIMAL EXPONENT
JUMPN REG1 ,.+3 ;VALUE EQUAL ZERO ?
MOVEI AC0 ,555555 ;YES - REMEMBER IT IN AC0
JRST WRTFF ;AND WRITE IT OUT
CAML REG1 ,[10.0] ;REAL VALEU SHOULD BE LESS THEN 10.0
JRST TOOBIG ;AND GREATER OR EQUAL THEN 1.0
CAML REG1 ,[1.0]
JRST NOWCOR ;NOW CORRECTLY POSITIONED
FMPR REG1 ,[10.0] ;IT'S TOO SMALL
SOJA REG6 ,.-3 ;EXPONENT BECOMES NEGATIV - CHECK AGA
;IN
TOOBIG: FDVR REG1 ,[10.0] ;REAL VALUE IS TOO LARGE
AOJ REG6 , ;EXPONENT BECOMES POSITIV
CAML REG1 ,[10.0] ;STILL TOO LARGE?
JRST TOOBIG ;YES
NOWCOR: LDB REG2 ,[POINT 8,REG1,8] ;GETS BINARY EXPONENT
SUBI REG2 ,200
TLZ REG1 ,377000 ;CLEARS EXPONENT
LSH REG1 ,(REG2) ;SHIFTS MANTISSE BY BINARY EXPONENT L
;EFT
WRTFF: CAIN REG3 ,123456 ;FIXEDREAL OR FLOATING REAL ?
JRST WRTFLO ;FLOATING REAL
MOVEI REG2 ,(REG5) ;FIXED REAL - GET FORMAT
SUBI REG2 ,(REG3) ;REG3 CONTAINS NR OF DIGITS AFTER POI
;NT
JUMPL REG6 ,.+7 ;EXPONENT NEGATIV ?
HRRI REG4 ,1(REG6) ;NOW REG4 CONTAINS NR OF DIGITS BEFOR
; POINT
CAIGE REG2 ,1(REG4) ;FORMAT LARGE ENOUGH ?
JRST WRTFLO ;NO - WRITES FLOATING FORMAT IF POSSI
;BLE
CAIE AC0 ,555555 ;VALUE EQUAL ZERO ?
SETZ REG5 , ;NO - NO LEADING ZERO'S
JRST .+5
CAIGE REG2 ,2
JRST TOOSML
HRRI REG4 ,1 ;ONE ZERO BEFORE POINT
MOVM REG5 ,REG6 ;NUMBER OF LEADING ZEROS'S
MOVEI REG6 ,765432 ;TO REMEMBER THAT NO EXPONENT SHALL
;BE GIVEN OUT
SUBI REG2 ,1(REG4) ;FOR POINT AND DIGITS BEFORE POINT
JRST WRTOUT
WRTFLO: HRRI REG4 ,1 ;ONE DIGIT BEFORE POINT
SETZ REG2 , ;NORMALLY NO LEADING BLANKS
TLNE REG4 ,400000 ;SIGN EQUAL MINUS ?
JRST .+3 ;NO
MOVEI REG2 ,1 ;ONE LEADING BLANK FOR PLUS
SUBI REG5 ,1 ;ACCOUNT IN FORMAT LENGTH
CAIGE REG5 ,7 ;FORMAT BIG ENOUGH ?
JRST TOOSML ;NO - WRITES "*" 'S INTO FORMAT AND R
;ETURN
MOVEI REG3 ,-6(REG5) ;DIGITS BEHIND POINT
CAIE AC0 ,555555 ;VALUE EQUAL ZERO ?
SETZ REG5 , ;NO - NO LEADING ZERO'S IN FLOATING F
;ORMAT
;<REG1>: VALUE OF MANTISSE
;<REG2>: NR OF LEADING BLANKS
;<REG3>: NR OF DIGITS BEHIND POINT
;<REG4>: NR OF DIGITS BEFORE POINT
;<REG5>: NR OF LEADING ZERO'S
WRTOUT: PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS
PUSHJ TOPP ,WRTSGN ;WRITES SIGN
PUSHJ TOPP ,WRTMAT ;WRITES MANTISSE BEFORE POINT
MOVEI AC0 ,"." ;WRITES DECIMAL POINT OUT
PUSHJ TOPP ,PUTCH
MOVEI REG4 ,(REG3)
PUSHJ TOPP ,WRTMAT ;WRITES MANTISSE BEHIND POINT
CAIN REG6 ,765432 ;WRITE EXPONENT OR NOT ?
JRST REARET ;NO
JUMPN REG6 ,.+3 ;EXPONENT EQUAL ZERO ?
MOVEI REG2 ,4 ;YES - WRITES BLANKS INSTEAD ZERO EXP
;ONENT
JRST WRTBLK ;AND RETURN TO SURCEPROGRAMM
MOVEI AC0 ,"E" ;YES - WRITE E OUT
PUSHJ TOPP ,PUTCH
MOVEI AC0 ,"+" ;WRITES SIGN OUT
SKIPGE REG6 ;EXPONENT POSITIV
MOVEI AC0 ,"-" ;NO - WRITE MINUS SIGN
PUSHJ TOPP ,PUTCH ;WRITES OUT SIGN
MOVM REG1 ,REG6 ;DEZIMAL EXPONENT TO REG1 - FOR WRITE
;INTEGER
MOVEI AC0 ,"0" ;TO WRITE ONE ZERO IF EXPONENT LESS T
;HAN 12
CAIGE REG1 ,12 ;EXPONENT GREATER 12
PUSHJ TOPP ,PUTCH ;NO - WRITE ONE ZERO OUT
MOVEI REG2 ,2 ;FORMAT - TWO DIGITS NORMALLY
CAIGE REG1 ,12 ;NEED MORE THAN ONE DIGIT ?
MOVEI REG2 ,1 ;NO - FORMAT ONLY ONE DIGIT
PUSHJ TOPP ,WRTINT ;WRITES DECIMAL EXPONENT OUT
REARET: POPJ TOPP , ;RETURN
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE WRTINT *** PROCEDURE WRTINT ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTINT
ENTRY WRTIN1
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
EXTERN TOOSML
EXTERN WRTBLK
EXTERN WRTSGN
EXTERN WRTOPN
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTINT
; - WRITE INTEGER FORMAT
; - REG1=INTEGER VALUE
; - REG2=TOTAL LENGTH OF OUTPUT
;
WRTIN1: HRRZI REG2 ,14 ;SET DEFAULT LENGTH 12
WRTINT: JUMPLE REG2 ,INTRET ;FIELDWIDTH = 0?
PUSHJ TOPP ,WRTOPN
JUMPE REG1 ,.+4
IDIVI REG1 ,12 ;GETS LOWEST DIGIT TO REG2
PUSH TOPP ,REG2 ;AND SAVES IT IN PUSH-LIST
AOJA REG4 ,.-3
TRNE REG4 ,777777 ;VALUE EQUAL 0?
JRST .+4 ;NO
SETZ REG2 , ;YES - PUTS ONE ZERO INTO PUSH-LIST
PUSH TOPP ,REG2
AOJ REG4 ,
CAIL REG5 ,(REG4) ;FORMAT LARGE ENOUGH ?
JRST .+6 ;YES
TLZ REG4 ,400000 ;CLEARS SIGN BIT IF ANY
SOJL REG4 ,.+3 ;RESET PUSH-LIST
POP TOPP ,REG2
JRST .-2
JRST TOOSML ;WRITES "*" 'S INTO FORMAT AND RETURNS
SUBI REG5 ,(REG4) ;GETS NUMBER OF LEADING BLANKS
MOVEI REG2 ,(REG5) ;WRITEBLANK-ROUTINE WORKS ON REG2
PUSHJ TOPP ,WRTBLK ;WRITES BLANKS IF ANY
PUSHJ TOPP ,WRTSGN ;WRITES SIGN : " " IF POSITIV,"-" IF
;NEGATIV
POP TOPP ,AC0 ;GETS DIGIT IN PUSH-LIST
ADDI AC0 ,"0" ;CONVERTS TO ASCII
PUSHJ TOPP ,PUTCH ;WRITES THEM OUT
SOJG REG4 ,.-3 ;MORE DIGITS ?
INTRET: POPJ TOPP , ;NO - RETURN
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE READI *** PROCEDURE READI ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY READI
;
;*** EXTERNAL REFERENCES ***
;
EXTERN GETSGN
EXTERN GETINT
EXTERN CONERR
EXTERN RTEST
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE READI
; - READ INTEGER NUMBER
; - <REG1>=INTEGER VARIABLE
;
READI: PUSHJ TOPP ,GETSGN ;GETS SIGN AND FIRST CHAR
PUSHJ TOPP ,RTEST ;TEST IF FIRST COMPONENT IN DIGITS
PUSHJ TOPP ,GETINT ;GETS INTEGER TO REG2
SKIPE REG3 ;SIGN EQUAL MINUS ?
MOVN REG2 ,REG2 ;YES - NEGATE INTEGER
JFCL 10 ,CONERR ;OVERFLOW BIT SET ?
MOVEM REG2 ,(REG1) ;PUTS INTEGER IN PLACE LOADED TO REG1
POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE TTYOPN *** PROCEDURE TTYOPN ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY TTYOPN
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE TTYOPN
; - PROMPT PASCAL USER IF TTY-INPUT
; TO HIS PROGRAM IS REQUESTED
;
TTYOPN: OUTSTR [ASCIZ/
TO CONTINUE, HIT THE RETURN KEY */]
POPJ TOPP ,
;
;*** LITERALS
;
LIT
PRGEND
TITLE OPEN *** PROCEDURES RESET AND REWRITE ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY RESETF
ENTRY REWRIT
ENTRY TMPBLK
;
;*** EXTERNAL REFERENCES ***
;
EXTERN SETEOF
EXTERN GETCH
EXTERN GET
EXTERN ASTOSX
EXTERN WRTPC
EXTERN TMPTST
EXTERN WRTFNM
EXTERN GETLN
EXTERN CLSFIL
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILDAT= 1 ;FLAG TO TEST FOR TEXT-FILE
FILBIN= 17 ;FLAG TO TEST FOR ASCII-MODE
FILPTR= 0 ;LH= PASCAL FILE FLAGS
;RH= PTR TO COMPONENT
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** CONSTANTS ***
;
TMPSIZ= 200
;
;*** ADDRESSES ***
;
.JBFF= 121
.JBREL= 44
;
;*** START OF VARIANT CODE
;
TMPFLG: XWD 0 ,0
RESFLG: XWD 0 ,0
TMPBLK: SIXBIT / /
IOWD 0 ,0
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE RESETF
; - OPEN A FILE FOR INPUT
; - READ 1ST COMPONENT
; - <REG>=FILE-BLOCK
;
RESETF: HRRZI AC0 ,FILBFH(REG) ;INPUT BUFFER HEADER ADDRESS
SETOM RESFLG ;RESET IN PROGRESS
PUSHJ TOPP ,REOPEN ;CLOSE AND REOPEN FILE
MOVEI AC1 ,GETLN ;ADDR FOR ASCII-MODE
HLR AC0 ,FILPTR(REG) ;TEXT-FILE?
TRNE AC0 ,FILDAT ;SKIP IF YES
MOVEI AC1 ,GET ;ADDR FOR BINARY-MODE
SKIPE TMPFLG ;TEMPCORE-FILE OPEN?
JRST TMPSKP ;YES, SKIP LOOKUP
SKIPN FILEOF(REG)
pushj topp ,reslkp ;restore lookup block and LOOKUP
JRST SETEOF ;ERROR ON LOOKUP OR OPEN
XCT FILIN(REG) ;SET UP INPUT BUFFER RING
SKIPA
JRST SETEOF ;NO FILE FOR NONDIRECTORY DEVICES
TMPSKP: SETZM TMPFLG ;TEMPCORE OPEN FINISHED
PUSHJ TOPP ,(AC1) ;GET FIRST COMPONENT (OR CHARACTER)
POPJ TOPP ,
reslkp: push topp ,filppn(reg) ;save PPN clobbered by LOOKUP
xct fillkp(reg) ;LOOKUP
caia
aos -1(topp)
pop topp ,filppn(reg) ;restore PPN
popj topp ,
;
;*** PROCEDURE REWRITE
; - OPEN A FILE FOR OUTPUT
; - <REG>=FILE-BLOCK
;
REWRIT: HRLZI AC0 ,FILBFH(REG) ;OUTPUT BUFFER HEADER ADDR
SETZM RESFLG ;REWRITE IN PROGRESS
PUSHJ TOPP ,REOPEN ;CLOSE AND REOPEN FILE
AOSG FILEOF(REG) ;ERROR ON OPEN ?
JRST REWERR ;YES
pushj topp ,rewent ;go ENTER
JRST REWERR ;ERROR ON ENTER
XCT FILOUT(REG) ;SET UP BUFFER RING
POPJ TOPP , ;OK - RETURN
REWERR: OUTSTR [ASCIZ/
%? NO ACCESS TO OR NO DISK SPACE FOR FILE /]
PUSHJ TOPP ,WRTFNM
OUTSTR [ASCIZ/: ERROR IN REWRITE/]
JRST WRTPC
rewent: push topp ,filppn(reg) ;save PPN clobbered by ENTER
xct filent(reg) ;ENTEr
caia
aos -1(topp)
pop topp ,filppn(reg)
popj topp ,
;
;*** PROCEDURE TEMPCR
; - ALLOCATE SPACE FOR TEMP-CORE BUFFER
; - ISSUE TMPCOR-UUO
; - FAKE BUFFER-HEADER
; - PREPARE OPEN FOR DISK-FILE IF UUO FAILS
; - <REG>=FILE-BLOCK
;
TEMPCR: SKIPN RESFLG ;RESET?
JRST TMPSW ;NO, REWRITE
HRRZ AC1 ,.JBFF ;1ST FREE WORD
HRRZ AC0 ,.JBREL ;END OF USER-CORE
CAIGE AC0 ,TMPSIZ(AC1) ;WILL BUFFER FIT?
JRST [
ADDI AC0 ,TMPSIZ ;CORE NEEDED TO AC1
CORE AC0 , ;GET ANOTHER K
JRST TMPER1 ;BULLSHIT
JRST .+1] ;BACK IN LINE
HRRM AC1 ,TMPBLK+1 ;BUFFER-ADDR TO CONT.-BLOCK
SOS TMPBLK+1 ;PROPER IOWD-FORMAT
MOVEI AC0 ,-TMPSIZ ;MAX READ-LENGTH
HRLM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
HRLI AC1 ,440700 ;ASCII-BYTE-PTR
HRR AC0 ,FILSTA(REG) ;ASCII-MODE?
TRNE AC0 ,FILBIN ;SKIP IF YES
HRLI AC1 ,444400 ;BINARY-BYTE-PTR IF NOT
MOVEM AC1 ,FILBTP(REG) ;BYTE-PTR TO BUFFER-HEADER
MOVE AC0 ,FILNAM(REG) ;FILNAME
MOVEM AC0 ,TMPBLK ;TO CONT.BLOCK
MOVE AC0 ,[XWD 2,TMPBLK] ;DO TEMPCORE-READ
TMPCOR AC0 , ;WITH DELETE
JRST TMPSW ;FAILED
ADDM AC0 ,.JBFF ;SAVE DATA FROM DELETION
HRR AC1 ,FILSTA(REG) ;BINARY-MODE?
TRNN AC1 ,FILBIN ;SKIP IF YES
IMULI AC0 ,5 ;CALCULATE BYTE-COUNT
MOVEM AC0 ,FILBTC(REG) ;STORE INTO BUFFER-HEADER
SETOM TMPFLG ;SHOW TEMPCORE-READ
JRST FIXBUF ;CONTINUE IN MAIN STREAM
TMPSW: PJOB REG1 , ;GET JOBNAME
MOVEI AC0 ,3 ;LENGTH IN DECIMAL
MOVE REG3 ,FILNAM(REG) ;GET FILENAME
TMPLP: IDIVI REG1 ,12 ;CONVERT
ADDI REG2 ,"0"-40 ;JOBNAME
LSHC REG2 ,-6 ;TO
SOJG AC0 ,TMPLP ;SIXBITIZED DECIMAL
MOVEM REG3 ,FILNAME(REG) ;NEW FILENAME IS NNNXXX.YYY
JRST TMPRET ;RETRY FROM DISK
;
;*** PROCEDURE REOPEN
; - CLOSE A FILE
; - OPEN SAME OR NEW FILE
; - <REG>=FILE-BLOCK
; - <REG1>=FILENAME
; - REG2=PROTECTION-CODE
; - REG3=PROJ.-PROGR.-NR.
; - <REG4>=DEVICE
;
REOPEN: HRRZ REG6 ,FILBFH(REG) ;GET ADDRESS OF NEXT BUFFER IN RING
SETZM TMPFLG ;NO TEMPCORE-FILE
SKIPE REG4 ;NEW DEVICE
SETZM REG6 ;YES - FORCE GETTING NEW
;BUFFERS AFTER OPEN
PUSHJ TOPP ,CLSFIL ;CLOSE
MOVEM AC0 ,FILSTA+2(REG) ;INSERT APPROPRIATE BF-HEADER ADDRESS
LSH REG2 ,33 ;SHIFT LEFT PROT 27 BITS
MOVEM REG2 ,FILPROT(REG) ;INSERT PROTECTION CODE
HLLZS AC1 ,FILEXT(REG) ;TO GET CORRECT CRE-DATE
JUMPE REG1 ,OPN ;RETAIN PREVIOUS FILENAME
;AS DEFAULT IF NO ADDRESS IS SPECIFIED
movem reg3 ,filppn(reg) ;project-progr. number
HRRI AC1 ,FILNAM(REG) ;WHERE TO DEPOSIT IT
MOVEI REG5 ,11 ;BYTE COUNT
PUSHJ TOPP ,ASTOSX ;CONVERT FILENAME TO SIXBIT
JUMPE REG4 ,OPN ;NEW DEVICE ?
MOVEI REG1 ,(REG4) ;YES - GET ADDRESS OF DEVICE NAME
MOVEI AC1 ,FILSTA+1(REG) ;AND WHERE TO PUT SIXBIT NAME
MOVEI REG5 ,6 ;BYTE COUNT
PUSHJ TOPP ,ASTOSX ;CONVERT TO SIXBIT
OPN: SETZM FILEOF(REG) ;CLEAR EOF - MARKER
SETZM FILEOL(REG) ;CLEAR EOL - MARKER
AOS FILEOL(REG) ;SET EOL TO FORCE TEST FOR LINENR.
SETZM FILCMP(REG) ;CLEARS COMPONENT
MOVE AC0 ,[ASCII/-----/] ;INITIALIZE LINE-NUMBER
MOVEM AC0 ,FILLNR(REG)
HLR AC0 ,FILPTR(REG) ;FILE-FORM?
TRNN AC0 ,FILDAT ;SKIP IF BINARY
HRRZS FILCNT(REG) ;CLEAR CHARACTERCOUNT IF ASCII
PUSHJ TOPP ,TMPTST ;IS IT A TEMP-FILE?
JRST TEMPCR ;YES, OPEN TEMPCORE-FILE
TMPRET: XCT FILOPN(REG) ;OPEN
JRST SETEOF ;ERROR ON OPEN
FIXBUF: JUMPE REG6 ,REOPRT ;BUFFER RING ESTABLISHED ?
TLO REG6 ,400000 ;YES - RESET RING USE BIT
MOVEM REG6 ,FILBFH(REG) ;
HRLZI AC0 ,400000 ;MASK TO CLEAR BUFFER USE BIT
ANDCAM AC0 ,(REG6)
HRR REG6 ,(REG6) ;ADDRESS OF NEXT BUFFER IN RING
CAME REG6 ,FILBFH(REG) ;ONCE AROUND ?
JRST .-3 ;NOT YET
REOPRT: POPJ TOPP , ;OK - RETURN
TMPER1: OUTSTR [ASCIZ/
%? NOT ENOUGH CORE TO READ TEMPCORE-FILE /]
PUSHJ TOPP ,WRTFNM
JRST WRTPC
;
;*** LITERALS
;
LIT
PRGEND
TITLE REASTR *** PROCEDURES READS AND READPS ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY READS
ENTRY READPS
;
;*** EXTERNAL REFERENCES ***
;
EXTERN CONERR
EXTERN GETCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE READS/READPS
; - READ STRING/PACKED STRING
; - <REG>=FILE-BLOCK
; - <REG1>=STRING
; - REG2=LENGTH
;
READS: MOVE REG3 ,[POINT 36,(REG1),-1] ;BYTE-PTR FOR FULLWORD
SKIPA
READPS: MOVE REG3 ,[POINT 7,(REG1),-1] ;BYTE-PTR FOR PACKED-ASCII
SKIPBL: MOVE AC0 ,FILCMP(REG) ;FETCH COMP.
CAIE AC0 ," " ;BLANK?
JRST NONBLK ;NO
PUSHJ TOPP ,GETCH ;SKIP BLANK
JRST SKIPBL ;LOOP AROUND
NONBLK: CAIE AC0 ,"'" ;HYPHON?
JRST CONERR ;HMM...
PUSHJ TOPP ,GETCH ;SKIP IT
MOVEI REG4 ," " ;PREV. CHAR NON-HYPHON
SKIPA
READLP: PUSHJ TOPP ,GETCH ;GET NEXT
MOVE AC0 ,FILCMP(REG) ;FETCH 1ST BYTE OF STRG
CAIN AC0 ,"'" ;HYPHON?
JRST HYPHON ;YES
CAIN REG4 ,"'" ;PREV. CHAR HYPHON?
JRST CONERR ;YES-MUST NOT HAPPEN
JRST DEPSIT ;NO-DEPOSIT CHAR
HYPHON: CAIN REG4 ,"'" ;PREV. CHAR HYPHON?
JRST DEPSIT ;YES-DEPOSIT HYPH.
MOVE REG4 ,AC0 ;SAVE HYPHON
JRST READLP ;LOOP AROUND
DEPSIT: IDPB AC0 ,REG3 ;DEPOSIT BYTE
MOVEI REG4 ," " ;PREV. CHAR NON-HYPHON
SOJG REG2 ,READLP ;LOOP AROUND
PUSHJ TOPP ,GETCH
MOVE AC0 ,FILCMP(REG) ;FETCH LAST BYTE
CAIE AC0 ,"'" ;IS IT A HYPHON?
JRST CONERR ;SORRY...
PUSHJ TOPP ,GETCH ;POSITION FILE
POPJ TOPP , ;AND RETURN TO USER
;
;*** LITERALS
;
LIT
PRGEND
TITLE CLOSE *** PROCEDURE CLSFIL ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY CLSFIL
;
;*** EXTERNAL-REFERENCES ***
;
EXTERN TMPCR1
EXTERN TMPTST
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** PROCEDURE CLSFIL
; - CLOSE OPENED FILE
; - ISSUE TEMPCORE-UUO ON TEMP-FILES
; - <REG>=FILE-BLOCK
;
CLSFIL: SKIPN AC1, FILSTA+2(REG) ;NEVER OPENED?
POPJ TOPP, ;YES - NOTHING TO CLOSE
TLNN AC1, 777777 ;OPEN FOR OUTPUT?
JRST CLSIN ;NO - CLOSE IT
PUSHJ TOPP, TMPCR1 ;ISSUE TEMPCORE-UUO
;IF TEMP-FILE
PUSHJ TOPP, TMPTST ;WAS IT TEMP-FILE?
POPJ TOPP, ;YES - NOTHING TO CLOSE
CLSIN: XCT FILCLS(REG) ;CLOSE FILE
POPJ TOPP, ;RETURN TO CALLER
;
;*** LITERALS
;
LIT
PRGEND
TITLE PUT *** PROCEDURES PUT, PUTCH, PUTLN, PUTPG AND TMPCRW ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY PUT
ENTRY TMPCRW
ENTRY TMPCR1
ENTRY PUTCH
ENTRY PUTBUF
ENTRY PUTLN
ENTRY PUTPG
;
;*** EXTERNAL-REFERENCES ***
;
EXTERN PUTERR
EXTERN TMPBLK
EXTERN SETEOF
EXTERN TMPTST
EXTERN WRTPC
EXTERN WRTFNM
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILBIN= 17 ;FLAGS TO TEST FOR ASCII-MODE
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** CONSTANTS ***
;
TMPSIZ= 200
;
;*** START OF VARIANT CODE
;
CLSFLG: XWD 0,0
RENBLK: XWD 0,0
XWD 0,0
XWD 0,0
XWD 0,0
RENUUO: XWD 0,RENBLK
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** PROCEDURE PUTCH
; - PUT ONE CHAR
; - <REG>=FILE-BLOCK
; - AC0=CHAR
;
PUTCH: SKIPG FILEOF(REG) ;EOF?
JRST PUTNEOF ;NO
PTCTEST:SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER?
JRST [
PUSHJ TOPP ,PUTBF1 ;PUT CURRENT BUFFER
JRST PTCTEST] ;RET TO CALLER
IDPB AC0 ,FILBTP(REG) ;DEPOSIT CHARACTER IN OUTPUT BUFFER
POPJ TOPP , ;RETURN
;
;*** PROCEDURE PUT
; - PUT FILE-COMPONENT
; - <REG>=FILE-BLOCK
;
PUT: SKIPG FILEOF(REG) ;EOF ?
JRST PUTNEOF ;NO
MOVE AC1 ,FILCNT(REG) ;GET TRANSFER COUNT
;FOR FILE COMPONENT
PUTEST: SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER ?
JRST [
PUSHJ TOPP ,PUTBF1 ;PUT CURRENT BUFFER
JRST PUTEST] ;RET TO CALLER
MOVE AC0 ,(AC1) ;GET NEXT WORD OF COMPONENT
IDPB AC0 ,FILBTP(REG) ;DEPOSIT IN OUTPUT BUFFER
AOBJN AC1 ,PUTEST ;MORE WORDS IN COMPONENT ?
POPJ TOPP , ;NO
;
;*** PROCEDURE PUTBUF
; - PUT CURRENT BLOCK
; DISK-BLOCKS ARE ALWAYS FILLED UP
; WITH ZEROS TO 128 WORDS, EXCEPT OF
; THE LAST ONE WRITTEN BY CLOSE
; - <REG>=FILE-BLOCK
;
PUTBUF: PUSHJ TOPP ,PUTBF1
POPJ TOPP ,
PUTBF1: PUSHJ TOPP ,TMPCRW ;WRITE TEMP-FILE
XCT FILOUT(REG) ;PUT BUFFER
POPJ TOPP , ;OK-RETURN TO CALLER
JRST PUTERR ;I/O-ERROR
PUTNEOF:OUTSTR [ASCIZ/
%? REWRITE FOR FILE /]
PUSHJ TOPP ,WRTFNM
OUTSTR [ASCIZ/ REQUIRED/]
JRST WRTPC
;
;*** PROCEDURE PUTLN
; - WRITE <CR><LF>
; - <REG>=FILE-BLOCK
;
PUTLN: MOVEI AC0 ,15 ;<CR>
PUSHJ TOPP ,PUTCH
MOVEI AC0 ,12 ;<LF>
PUSHJ TOPP ,PUTCH
POPJ TOPP ,
;
;*** PROCEDURE PUTPG
; - WRITE <CR><FF>
; - <REG>=FILE-BLOCK
;
PUTPG: MOVEI AC0 ,15 ;<CR>
PUSHJ TOPP ,PUTCH ;
MOVEI AC0 ,14 ;<FF>
PUSHJ TOPP ,PUTCH
POPJ TOPP ,
;
;*** PROCEDURE TMPCRW
; - ISSUE TMPCOR-UUO ON CURRENT BUFFER
; - RETURN TO CALLER IF UUO FAILS
; - SET EOF TO PREVENT WRITING OF
; MORE THAN 1 BUFFER IF OK
; - <REG>=FILE-BLOCK
;
TMPCR1: SETOM CLSFLG ;COMING FROM CLSFIL OR REOPEN
SKIPA
TMPCRW: SETZM CLSFLG ;COMING FROM PUTBUFFER
PUSH TOPP ,AC0
PUSH TOPP ,AC1
PUSH TOPP ,REG1
HLLZ AC1 ,FILEXT(REG)
CAME AC1 ,[SIXBIT/TMP /]
JRST LEAVE
HLLZ AC1 ,FILNAM(REG)
CAMLE AC1 ,[SIXBIT/999 /]
JRST LEAVE
HRLZ AC0 ,FILNAM(REG)
MOVEM AC0 ,TMPBLK ;PTR TO CONT.-BLOCK
MOVE AC0 ,FILBTC(REG) ;BUFFER'S BYTE-COUNT
HRR AC1 ,FILSTA(REG) ;BINARY-MODE?
TRNN AC1 ,FILBIN ;SKIP IF YES?
PUSHJ TOPP ,ASCFI ;CORRECT BYTE-COUNT
SUBI AC0 ,TMPSIZ ;GET NEG NUM OF CHARS
HRLM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
HRR AC0 ,FILBFH(REG) ;GET BUFFER'S ADDR
ADDI AC0 ,1 ;POINT TO 1ST CHAR
HRRM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
MOVE AC0 ,[XWD 3,TMPBLK] ;DO TEMPCORE
TMPCOR AC0 , ;WRITE
JRST LEAVE
HRLZI AC0 ,400000 ;KILL
IORM AC0 ,FILBFH(REG) ;BUFFER-RING
XCT FILCLS(REG) ;CLOSE DISK FILE
HLL AC1, FILENT(REG) ;SET
TLZ AC1, 22000 ;UP
HLLM AC1, RENUUO ;RENAME-UUO
XCT RENUUO ;AND DELETE DISK FILE
SKIP
MOVE AC1, FILNAM(REG) ;RESTORE
HRLZM AC1, FILNAM(REG) ;FILENAME
SKIPE CLSFLG
JRST LEAVE
POP TOPP ,REG1 ;RESTORE REG1
POP TOPP ,AC1 ;RESTORE AC1
POP TOPP ,AC0 ;RESTORE AC0
POP TOPP ,
POP TOPP ,
JRST SETEOF
LEAVE: POP TOPP ,REG1 ;RESTORE REG1
POP TOPP ,AC1
POP TOPP ,AC0
POPJ TOPP ,
ASCFI: IDIVI AC0 ,5
CAIG AC1 ,0
POPJ TOPP ,
MOVEI REG1 ," "
IDPB REG1 ,FILBTP(REG)
SOJG AC1 ,.-1
POPJ TOPP ,
;
;*** LITERALS
;
LIT
PRGEND
TITLE GET *** PROCEDURES GET, GETCH AND GETLN ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY GET
ENTRY GETBUF
ENTRY GETCH
ENTRY GETLN
;
;*** EXTERNAL REFERENCES ***
;
EXTERN TMPTST
EXTERN SETEOF
EXTERN WRTPC
EXTERN WRTFNM
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** PROCEDURE GETLN
; - READ 1ST CHAR OF NEXT LINE
; - TEST FOR LINE-NUMBER AND PAGE-MARK
; - <REG>=FILE-BLOCK
;
PUSHJ TOPP ,GETCH ;GETS NEXT CHARACTER IN LINE
GETLN: SKIPN FILEOL(REG) ;IS EOLN = TRUE
JRST GETLN-1 ;NO - CHARAKTER'S IN LINE
;WILL BE OVERREAD
MOVE AC0 ,[ASCIZ/-----/] ;ARR. SET THE LINE NUMBER TO DASHES
MOVEM AC0 ,FILLNR(REG)
PUSHJ TOPP ,GETCNT ;GET 1ST CHAR OF NEXT LINE
SKIPE FILEOF(REG) ;EOF?
JRST GETEOF ;YES
MOVEI AC0 ,1 ;TEST FOR LINENR OR PAGEMARK
TDNN AC0 ,@FILBTP(REG) ;LAST BIT EQUAL ZERO?
JRST GETRET ;YES - RETURN
MOVE AC1 ,@FILBTP(REG) ;NO - GET LINENUMBER OR PAGEMARK
TRZ AC1 ,1 ;BIT 35 TO ZERO
MOVEM AC1 ,FILLNR(REG) ;STORE IT TO FILLNR
MOVE AC0 ,FILBTC(REG)
SUBI AC0 ,5 ;TO OVERREAD LAST FOUR DIGITS AND TAB
JUMPGE AC0 ,GETNCP ;ALL THIS FIVE CHARACTERS IN THIS BUF
;FER?
PUSHJ TOPP ,GETBUF ;GET A NEW BUFFER
IBP FILBTP(REG) ;TO OVERREAD TAB OR FIRST CARRIGE RET
;URN
SOS FILBTC(REG)
JRST .+3
GETNCP: MOVEM AC0 ,FILBTC(REG) ;RESTORE BYTECOUNT
AOS FILBTP(REG) ;INCREMENTS BYTEPOINTER BY 5
;4 DIGITS AND TAB
HRRZS FILCNT(REG) ;SETS CHARACTERCOUNT TO ZERO
;
;*** PROCEDURE GETCH
; - READ ONE CHAR
; - <REG>=FILE-BLOCK
;
GETCH: SKIPE FILEOF(REG) ;EOF ?,(GETCH GETS ONE CHARACTER,TEXT
;FILES ONLY)
JRST GETEOF ;YES - TEST WETHER TOO MANY
;ATTEMPTS TO OVERREAD EOF
SKIPE FILEOL(REG) ;EOLN ?
JRST GETLN ;YES - LOOK FOR LINER
getcnt: skipn filsta+2(reg) ;file open?
jrst geterr ;no - pufffffff
MOVE AC1 ,FILCNT(REG) ;GET TRANSFER WORD FOR FILECOMPONENT
JUMPGE AC1 ,GTCTEST ;REMAINING BLANKS FREE?
AOBJP AC1 ,.+1 ;YES - INCREMENT CHARACTERCNT
;(WILL NEVER JUMP)
TLNN AC1 ,7 ;CHARACTERCNT IS ZERO MODE 7
TLZ AC1 ,400000 ;YES - CLEAR TAB INDICATOR
JRST GETRET
PUSHJ TOPP ,GETBUF ;GET NEXT BUFFER
GTCTEST:SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER ?
JRST GTCTEST-1 ;NO - GO FOR NEXT BUFFER
ILDB AC0 ,FILBTP(REG) ;GET NEXT BYTE
MOVEM AC0 ,(AC1) ;DEPOSIT IT IN FILE COMPONENT
AOBJN AC1 ,GTCTEST ;NEVER JUMPS
SETZM FILEOL(REG) ;RESETS FILEOL IN ASCII-FILE
CAILE AC0 ,137 ;CHECK FOR LEGAL PASCAL-CHARACTER
JRST GETCON ;CORRECT LOWER TO UPPER CASE
CAIL AC0 ," " ;BELOW BLANK ?
JRST GETRET ;NO-VALID PASCAL CHAR
CAIE AC0 ,14 ;ARR. FORM FEED?
JRST .+4 ;NO - CHECK THE OTHER CASES
MOVE AC0 ,[ASCIZ/ /] ;YES - PUT BLANKS IN LINENR
MOVEM AC1 ,FILLNR(REG)
JRST GETLF ;AND SIMULATE AN END OF LINE
CAIN AC0 ,11 ;HORIZONTAL TAB
JRST GETTAB ;YES
CAIE AC0 ,12 ;LINE FEED?
JRST GETCNT ;NO - FORGET IT
GETLF: AOS FILEOL(REG) ;SET EOLN
SETZ AC1 , ;CLEARS CHARACTERCOUNT
JRST GETBLK ;GET BLANK IF LF
GETCON: SUBI AC0 ,40 ;CORR. CHAR
JRST GETNEW ;DEP. INTO FILCOMP
GETTAB: TLNE AC1 ,7 ;IS THIS TAB ON
;CHARACTERCOUNT MODULO 8 = 0
TLO AC1 ,400000 ;NO -SETS TAB INDICATOR
GETBLK: MOVEI AC0 ," "
GETNEW: MOVEM AC0 ,FILCMP(REG)
GETRET: HLLM AC1 ,FILCNT(REG) ;SAVES NEW CHARACTERCNT AND TAB INDIC
;ATOR
POPJ TOPP ,
GETEOF: AOSGE FILEOF(REG) ;TOO MANY ATTEMPTS ?
POPJ TOPP , ;NO - RETURN
AOS FILEOF(REG) ;SET EOF TRUE
OUTSTR [ASCIZ/
%? INPUT ERROR: ATTEMPT TO READ BEYOND EOF OF /]
errout: PUSHJ TOPP ,WRTFNM ;WRITE FILE NAME
JRST WRTPC
geterr: outstr [asciz/
%? INPUT ERROR: RESET REQUIRED FOR /]
jrst errout
;
;*** PROCEDURE GET
; - READ NEXT FILE-COMPONENT
; - <REG>=FILE-BLOCK
;
GET: SKIPE FILEOF(REG) ;EOF?
JRST GETEOF ;YES-TEST WETHER TOO MANY ATTEMPTS TO
; OVERREAD EOF
MOVE AC1 ,FILCNT(REG) ;GET TRANSFER WORD FOR FILECOMPONENT
GETEST: SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER?
JRST [
PUSHJ TOPP ,GETBUF ;GET NEXT BUFFER
JRST GETEST] ;RETURN TO CALLER
ILDB AC0 ,FILBTP(REG) ;GET NEXT BYTE
MOVEM AC0 ,(AC1) ;DEPOSIT IT IN FILECOMPONENT
AOBJN AC1 ,GETEST ;MORE BYTES IN THIS COMPONENT?
POPJ TOPP , ;NO ,RETURN
;
;*** PROCEDURE GETBUF
; - GET NEXT BUFFER
; - <REG>=FILE-BLOCK
;
GETBUF: PUSHJ TOPP ,TMPTST ;IS IT A TEMPFILE?
JRST BADIO ;YES-ONLY 1 BUFFER ALLOWED
XCT FILIN(REG) ;GET NEXT BUFFER
POPJ TOPP , ;OK-RETURN TO CALLER
BADIO: POP TOPP , ;FORGET LAST LINK
JRST SETEOF ;SET EOF IF ERROR
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE DATE *** PROCEDURE DATE ***
opdef dateuu [date]
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY DATE.
ENTRY DATE
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE DATE
; - STORE STANDARD ASCII-DATE
; DD-MMM-YY INTO LOCATION <REG>
; - <REG>=ASCII/10 CHAR. DATE/
;
GETINF: ;GETTAB AC0 , ;GET VALUE FROM SYSTEM-TABLE
; POPJ TOPP ,
IDIVI AC0 ,144
HRRZ AC0 ,AC1
IDIVI AC0 ,12 ;DIV BY 10
ADDI AC0 ,60 ;GET TWO
ADDI AC1 ,60 ;ASCII NUMBERS
IDPB AC0 ,REG1 ;DEPOSIT 1ST
IDPB AC1 ,REG1 ;DEPOSIT 2ND
POPJ TOPP , ;RETURN TO CALLER
DATE:
DATE.: PUSH TOPP ,REG1 ;SAVE
PUSH TOPP ,REG2 ;THREE
PUSH TOPP ,REG3 ;REGS
MOVE REG1 ,[POINT 7,(REG),-1] ;BTP FOR DATE-STRING
; MOVE AC0 ,[XWD 60,11] ;GET DAY
dateuu reg2,
idivi reg2,↑D31
movei ac0,1(reg3)
PUSHJ TOPP ,GETINF
HRRZI AC0 ,"-" ;DEPOSIT "-"
IDPB AC0 ,REG1
; MOVE AC1 ,[XWD 57,11] ;GET MONTH
; GETTAB AC1 ,
; JRST END ;MERDE
; MOVE REG2 ,[POINT 7,MONTHS-1(AC1),-1] ;BTP FOR MONTH-ABBREV.
idivi reg2,↑D12
movei ac1,↑D1964(reg2)
movei reg2,months(reg3)
hrli reg2,440700
HRRZI REG3 ,3 ;COUNTER
LOOP: ILDB AC0 ,REG2 ;GET CHAR
IDPB AC0 ,REG1 ;DEPOSIT IN STRING
SOJG REG3 ,LOOP ;DO IT THREE TIMES
HRRZI AC0 ,"-" ;ANOTHER "-"
IDPB AC0 ,REG1
; MOVE AC0 ,[XWD 56,11] ;GET YEAR
move ac0,ac1
PUSHJ TOPP ,GETINF
HRRZI AC0 ," "
IDPB AC0 ,REG1
END: POP TOPP ,REG3 ;RESTORE
POP TOPP ,REG2 ;SAVED
POP TOPP ,REG1 ;REGS
POPJ TOPP , ;RET TO CALLER
MONTHS: ASCIZ/JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC /
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE TIME *** PROCEDURE TIME ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY TIME.
ENTRY TIME
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE TIME
; - STORE STANDARD ASCII-TIME
; HH:MM:SS INTO LOCATION <REG>
; - <REG>=ASCII/10 CHAR. TIME/
;
GETINF: ;GETTAB AC0 , ;GET VALUE FROM SYSTEM-TABLE
; POPJ TOPP ,
IDIVI AC0 ,12 ;DIV BY 10
ADDI AC0 ,60 ;GET TWO
ADDI AC1 ,60 ;ASCII NUMBERS
IDPB AC0 ,REG1 ;DEPOSIT 1ST
IDPB AC1 ,REG1 ;DEPOSIT 2ND
POPJ TOPP , ;RETURN TO CALLER
TIME:
TIME.: PUSH TOPP ,REG1 ;SAVE REG1
MOVE REG1 ,[POINT 7,(REG),-1] ;BTP FOR TIME-STRING
timer ac0,
idivi ac0,↑D60
idivi ac0,↑D60
push topp,ac1 ; push seconds
idivi ac0,↑D60
push topp,ac1 ; push minutes
; MOVE AC0 ,[XWD 61,11] ;GET HOURS
PUSHJ TOPP ,GETINF
HRRZI AC0 ,":" ;DEPOSIT ":"
IDPB AC0 ,REG1
pop topp,ac0
; MOVE AC0 ,[XWD 62,11] ;GET MINUTES
PUSHJ TOPP ,GETINF
HRRZI AC0 ,":" ;ANOTHER ":"
IDPB AC0 ,REG1
pop topp,ac0
; MOVE AC0 ,[XWD 63,11] ;GET SECONDS
PUSHJ TOPP ,GETINF
HRRZI AC0 ," "
IDPB AC0 ,REG1
HRRZI AC0 ," "
IDPB AC0 ,REG1
END: POP TOPP ,REG1 ;RESTORE REG1
POPJ TOPP , ;RETURN TO CALLER
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE EXIT *** PROCEDURES WRTPC AND OTHER EXITS ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTPC
ENTRY CORERR
ENTRY OVERF.
ENTRY INXERR
ENTRY SRERR
ENTRY CONERR
ENTRY PUTERR
ENTRY END
ENTRY STOP
ENTRY IPTERR
ENTRY SETERR
ENTRY NOCORE
ENTRY PTRERR
;
;*** EXTERNAL REFERENCES ***
;
EXTERN WRTFNM
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
BASIS= 16
TOPP= 17
;
;*** ADDRESSES ***
;
.JBDDT= 74
.JBTPC= 127
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE WRTPC
; - WRITE USER'S PC AND JUMP
; INTO PASDDT IF LOADED
;
WRTPC: OUTSTR [ASCIZ/ AT USER PC /]
HRRZ REG ,(BASIS) ;IF RH = LH = 0 THEN WE
HLRZ AC1 ,(BASIS) ;ARE ON MAIN-PROGRAM LEVEL
CAIN REG ,(AC1) ;IS IT MAIN?
JRST MAIN ;YES
HRRZ REG ,-1(REG) ;GET STARTADD. OF THIS PROCEDURE
SEARCH: HLRZ AC1 ,(REG) ;SEARCH THE INSTRUCTION
CAIE AC1 ,541757 ;HRRI 17,X(17) WHERE X-1 IS THE
AOJG REG ,SEARCH ;LENGTH OF THE ACTIVATION-RECORD
HRRZ AC1 ,(REG) ;THIS IS THE FIRST JUMP
GETADR: ADDI AC1 ,1(BASIS) ;INTO THE RUNTIME-SUPPORT
HRRZ REG ,(AC1) ;RETURN-ADDR IN REG FOR PASDDT
SOJ REG , ;ALWAYS MINUS ONE
HRRZI REG2 ,6
MOVE REG3 ,[POINT 3,REG,17]
ILDB AC1 ,REG3
ADDI AC1 ,60
OUTCHR AC1 ;WRITE PC
SOJG REG2 ,.-3
MOVEI AC1 ,15
OUTCHR AC1
MOVEI AC1 ,12
OUTCHR AC1
HRR AC1 ,.JBDDT ;LOAD PASDDT-ADDR
JUMPE AC1 ,END ;EXIT
JRST 0 ,-1(AC1) ;GOTO 'ERRDB.'
END: EXIT ;EXIT TO MONITOR
MAIN: HRRZ REG ,400000 ;START ADDR OF PROGRAM
HRRZ AC1 ,3(REG) ;WORDS OF STACK USED BY MAIN
JRST GETADR ;CONTINUE TO CALC. USER PC
CORERR: OUTSTR [ASCIZ/
%? STACK OVERRUNS HEAP: RETRY WITH MORE CORE/]
HRRZ REG ,(BASIS) ;TEST IF ERROR IN
HLRZ AC1 ,(BASIS) ;INITIALIZATION
CAIN REG ,(AC1) ;OF PROGRAM
JRST END
STOP: MOVEI TOPP ,-1(BASIS) ;RESET TOPP
HLR BASIS ,-1(BASIS) ;AND BASIS
JRST WRTPC
CONERR: OUTSTR [ASCIZ/
%? INPUT DATA ERROR IN FILE /]
PUSHJ TOPP ,WRTFNM
JRST WRTPC
INXERR: OUTSTR [ASCIZ/
%? ARRAY INDEX OUT OF BOUNDS/]
JRST WRTPC
SRERR: OUTSTR [ASCIZ/
%? SCALAR OUT OF RANGE/]
JRST WRTPC
PUTERR: OUTSTR [ASCIZ/
%? OUTPUT ERROR: DISK SPACE EXHAUSTED FOR FILE /]
PUSHJ TOPP ,WRTFNM ;WRITE FILE NAME
JRST WRTPC
OVERF.: OUTSTR [ASCIZ/
%? ARITHMETIC OVERFLOW OR ZERODIVIDE AT USER PC /]
HRRZ REG, .JBTPC
JRST GETADR+2
IPTERR: OUTSTR [ASCIZ/
%? SCALAR OUT OF RANGE IN FILE /]
PUSHJ TOPP ,WRTFNM
JRST WRTPC
SETERR: OUTSTR [ASCIZ/
%? MORE THAN 72 SET ELEMENTS/]
JRST WRTPC
NOCORE: OUTSTR [ASCIZ/
%? CORE REQUIREMENT GREATER THAN "CORMAX"/]
JRST WRTPC
PTRERR: OUTSTR [ASCIZ/
%? UNINITIALIZED OR NIL POINTER/] ; added by armando 12-sept-78
JRST WRTPC
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE DEBSP *** DEBUG SUPPORT ***
TWOSEG
;
;*** ENTRY-POINTS
;
ENTRY INDEB.
ENTRY EXDEB.
;
;*** EXTERNAL REFERENCES
;
EXTERN END,DEBUG
EXTERN OVERF.
;REGISTER DEFINITION
AC0=0
AC1=1
REGIN=1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1=REGIN+1+1
REG2=REGIN+1+2
REG3=REGIN+1+3
REG4=REGIN+1+4
REG5=REGIN+1+5
REG6=REGIN+1+6
JBFFLW=14
NEWREG=15
BUFFER=15
BASIS=16
TOPP=17
;
;*** DESCRIPTION OF FILEBLOCK( SEE WRITEMC)
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS=10
FILSTA=11 ; .+0 FOR FILESTATUS
; .+1 FOR DEVICE
; .+2 FOR POINTER TO BUFFERHEADER
FILNAM=14
FILEXT=15
FILPRO=16
FILPPN=17
FILBFH=20 ;BUFFER HEADER
FILBTP=21 ;BYTE POINTER
FILBTC=22 ;BYTE COUNT IN BUFFER
FILLNR=23 ;IF ASCII MODE - LINENR IN ASCIICHARACTERS
FILCNT=24 ;LH= IF BINARY MODE : NEG. NUMBER OF WORDS IN COMPONENT
; IF ASCII MODE : NR. OF CH. IN LINE AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONENT
FILCMP=25 ;FIRST WORD OF COMPONENT
;
;*** CONSTANTS
;
MAXEOF=10
DEBSIZE=2000 ;1K
;
;*** ADDRESSES
;
.JBREL= 44
.JBDDT= 74
.JBSA=120
.JBFF=121
.JBAPR=125
.JBCNI=126
.JBTPC=127
.JBOPC=130
RGSTRS=140
STACKBO=143
STATUS=144
LIMIT=145
.GTSGN=14
.GTLIM=40
;
;*** START OF VARIANT CODE
;
LOC .JBDDT ;UPDATE .JBDDT
XWD 0,DDTDB.
LOC .JBAPR ;UPDATE .JBAPR
XWD 0, APRINT ;INTERRUPT-ROUTINE
;
;*** START OF INVARIANT CODE
;
RELOC 400000
;
;*** PROCEDURE INDEB.
; - INITIALIZE DEBUG SYSTEM
;
INDEB.: JRST .+4 ;SKIP AROUND--KLUGE BY KUMAR
JUMPE AC1 ,.+3 ;NOT SHR
OUTSTR [ASCIZ/
%? PROGRAMS COMPILED WITH THE DEBUG-OPTION MUST NOT BE SHARABLE:
RETRY WITH .SAVE INSTEAD OF .SSAVE/]
JRST END
SOJ NEWREG , ;INCREMENT NEWREG
HRRI AC1 ,377777 ;LOAD FIRST LINK - WORD
HRLI AC1 ,377777 ;FOR HEAP - DUMP
MOVEM AC1 ,(NEWREG) ;DEPOSITE LINK - WORD
HRRZ AC1 ,.JBFF ;GET HIGHEST LOC
MOVEM AC1 ,RGSTRS ;OLD CORE-END BECOMES BEGIN OF DEBUG AREA
ADDI AC1 ,DEBSIZE
CORE AC1 , ;GET CORE FOR DEBUGGING
HALT ;ERROR RETURN
HRRZ AC1 ,RGSTRS
MOVEI AC1 ,DEBSIZE(AC1)
HRRM AC1 ,.JBFF
PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
SETZM 0 ,STATUS ;LH='INIT', RH=PROG.BEGIN
PUSHJ TOPP ,INIAPR ;
PUSHJ TOPP ,DEBUG.
POPJ TOPP ,
;
;*** PROCEDURE EXDEB.
; - ENTER THE DEBUG SYSTEM
;
EXDEB.: PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
HRLI AC1 ,1 ;STATUS='STOP'
HRR AC1 ,0(TOPP) ;RH=RETURNADDR
SUBI AC1 ,1 ;RH=STOPADDR
MOVEM AC1 ,STATUS
PUSHJ TOPP ,DEBUG. ;CALL DEBUG
POPJ TOPP ,
;
;*** AUXILIARY PROCEDURES OF THE DEBUG SYSTEM
;
HALT.: JRST 0 ,HALT1 ;THIS ENTRY MUST BE 2 LOC.
;BEFORE DDTDB.
ERRDB.: JRST 0 ,ERRDB1 ;THIS ENTRY MUST BE BEFORE DDTDB.
DDTDB.: PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
HRLI AC1 ,2 ;STATUS='DDT'
HRR AC1 ,.JBOPC ;RETURNADDR
MOVEM AC1 ,STATUS
PUSHJ TOPP ,DEBUG. ;CALL DEBUG
JRST 0 ,@.JBOPC ;RETURN TO PROGRAM
;*******************************************************************************
HALT1: HRLI AC0 ,4 ;STATUS='HALT'
SKIPA
ERRDB1: HRLI AC0 ,3 ;STATUS='RUNTIME ERROR'
HRRZ AC1 ,TOPP
CAML AC1 ,RGSTRS ;ERROR IN DEBUG?
JRST END
MOVEM AC0 ,STATUS
PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
PUSHJ TOPP ,DEBUG. ;CALL DEBUG
JRST 0 ,END ;EXIT
;*******************************************************************************
SAVERG: MOVEM AC0 ,@RGSTRS ;SAVE USER-REGISTERS
MOVE AC0 ,AC1
HRRZ AC1 ,RGSTRS
MOVEM AC0 ,1(AC1)
HRRI AC0 ,2(AC1)
HRLI AC0 ,2
BLT AC0 ,17(AC1)
POPJ TOPP ,0
;*******************************************************************************
INIAPR: ;MOVE AC1 ,[XWD -1, .GTLIM] ;ARGUMENT FOR GETTAB
; GETTAB AC1 , ;
; HALT ;ERROR RETURN
; TLNN AC1 ,200 ;TEST IF BATCH-JOB
; JRST NOTBAT ;NO
; TLZ AC1 ,777740 ;SET BITS 0-12 TO ZERO
; IMULI AC1 ,24 ;CONVERT JIFFIES TO MSEC
; MOVEM AC1 ,LIMIT ;STORE TIME LIMIT
; MOVEI AC1 ,21110 ;ARGUMENT FOR APRENB
; APRENB AC1 , ;ILL-MEM-REF + CLOCK-FLAG
; POPJ TOPP ,
;*******************************************************************************
NOTBAT: MOVEI AC1 ,1 ;STORE,THAT THIS JOB IS
HRLM AC1 ,STACKBO ;A TIMESSHARING-JOB
MOVEI AC1 ,20110 ;ARGUMENT FOR APRENB
APRENB AC1 , ;ILL-MEM-REF
POPJ TOPP ,
;*******************************************************************************
APRINT: MOVEM AC0 ,@RGSTRS ;SAVE AC0
HRRZ AC0 ,.JBCNI ;GET REASON FOR INTERRUPT
TRNE AC0 ,1000 ;TEST IF TIME INTERRUPT
JRST TIMINT ;JUMP TO TIME-INTERRUPT-ROUTINE
TRNE AC0 ,110 ;TEST IF ARITHMETIC OVERFLOW
JRST OVERF. ;YES
MOVE AC0 ,.JBTPC ;MOVE PC IN AC0
OUTSTR [ASCIZ/
%? ILLEGAL MEMORY REFERENCE/]
JRST ERRDB1 ;AND JUMP TO ERRDEB1
;*******************************************************************************
TIMINT: SETZ AC0 ,
RUNTIM AC0 , ;GET RUNTIME
SUB AC0 ,LIMIT ;
JUMPGE AC0 ,TIMLIM ;IF THERE IS NOT ENOUGH TIME
MOVEI AC0 ,21000 ;ARGUMENT FOR APRENB
APRENB AC0 ,
MOVE AC0 ,@RGSTRS ;RESTORE AC0
JRSTF @.JBTPC ;JUMP BACK TO THE PROGRAM
;*******************************************************************************
TIMLIM: OUTSTR [ASCIZ/
%? TIME LIMIT EXCEEDED/]
MOVE AC0 ,.JBTPC ;PC TO AC0
JRST ERRDB1 ;JUMP TO ERRDEB1
;
;*** PROCEDURE DEBUG.
; - SAVE USER REGISTERS
; - PROVIDE PROGRAM STACK FOR DEBUG SYSTEM
; - ENTER DEBUG SYSTEM
; - RESTORE USER REGISTERS AND RETURN
;
DEBUG.: MOVE AC1 ,RGSTRS ;GET DEBUG-REGISTERS
MOVEI NEWREG ,DEBSIZE(AC1)
MOVEI BASIS ,20(AC1)
MOVEI TOPP ,1(BASIS)
PUSHJ TOPP ,DEBUG ;DEBUG
HRLZ 17 ,RGSTRS ;RESTORE USER-REGISTERS
BLT 17 ,17
POPJ TOPP ,
;
;*** FUNCTION SHRCOD
; - RETURN TRUE IF HIGH-SEGMENT IS
; SHARABLE, OTHERWISE FALSE
;
SHRCOD: HRROI AC1 ,.GTSGN ;SEE IF HGH SEGM. IS SH.
GETTAB AC1 , ; LOOK AT .GTSGN TABLE
HALT ;ERROR RETURN
LSH AC1 ,777736 ;SHIFT BIT 1 TO RIGHTMOST PLACE
ANDI AC1 ,1 ;CLEAR THE OTHER BITS
POPJ TOPP ,
;
;*** LITERALS
;
LIT
PRGEND
TITLE WRTFNM *** PROCEDURES WRTFNM AND WRTSIX ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTFNM
ENTRY WRTSIX
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURES WRTFNM AND WRTSIX
; - WRITE CURRENT FILENAME(WRTFNM)
; - WRITE SIXBIT-STRING(WRTSIX)
; - <REG>=FILE-BLOCK
; - <REG1>=SIXBIT-STRING
; - REG2=LENGTH
;
WRTFNM: HRRI REG1 ,FILNAM(REG) ;ADDRESS OF FILENAME
MOVEI REG2 ,6 ;CHARACTER COUNT
WRTSIX: HRLI REG1 ,440600 ;SET UP BYTE POINTER
ILDB REG3 ,REG1 ;GET NEXT CHARACTER
ADDI REG3 ,40 ;CONVERT TO ASCII
OUTCHR REG3
SOJG REG2 ,.-3 ;MORE CHARACTERS ?
MOVEI REG3 ,56 ;INSERT PERIOD
OUTCHR REG3
MOVEI REG2 ,3 ;TYPE EXTENSION
ILDB REG3 ,REG1
ADDI REG3 ,40
OUTCHR REG3
SOJG REG2 ,.-3 ;ALL THREE BYTES TRANSFERRED ?
POPJ TOPP , ;RETURN
;
;*** LITERALS
;
LIT
PRGEND
TITLE TMPTST *** PROCEDURE TMPTST ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY TMPTST
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE TMPTST
; - TEST IF FILE IS TEMPCORE-FILE
; - <REG>=FILE-BLOCK
;
TMPTST: PUSH TOPP ,AC1 ;SAVE AC1
MOVE AC1 ,FILSTA+1(REG) ;GET DEVICE MNEMONIC
CAME AC1 ,[SIXBIT/DSK /] ;IS IT DSK?
JRST OUT1 ;NO
HRL AC1 ,FILNAM(REG) ;RIGHTMOST 3 OF FILNAM
HLR AC1 ,FILEXT(REG) ;LEFTMOST 3 OF EXTENSION
CAMN AC1 ,[SIXBIT/ TMP/] ;TEMP-FILE?
JRST OUT ;YES - RETURN TO OLD PC
OUT1: MOVE AC1 ,-1(TOPP) ;NO - RETURN TO OLD PC+1
AOJ AC1 ,
MOVEM AC1 ,-1(TOPP)
OUT: POP TOPP ,AC1
POPJ TOPP ,
;
;*** LITERALS
;
LIT
PRGEND
TITLE ASTOSX *** PROCEDURE ASTOSX ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY ASTOSX
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE ASTOSX
; - CONVERT ASCII- TO SIXBIT-STRING
; - <REG1>RH=ASCII-STRING
; - <AC1>RH=SIXBIT-STRING
; - REG5=LENGTH
;
ASTOSX: HRLI REG1 ,440700 ;SET UP BYTE POINTER TO PICK
;UP ASCII STRING
HRLI AC1 ,440600 ;
NXTBYT: ILDB AC0 ,REG1 ;GET BYTE
SUBI AC0 ,40 ;CONVERT TO SIXBIT
IDPB AC0 ,AC1
SOJG REG5 ,NXTBYT ;ALL BYTES TRANSFERRED ?
POPJ TOPP ,
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE REAAUX *** PROCEDURES GETSGN, GETINT AND RTEST ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY GETSGN
ENTRY GETINT
ENTRY RTEST
;
;*** EXTERNAL REFERENCES ***
;
EXTERN GETCH
EXTERN CONERR
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILPTR= 0
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURES GETSGN, GETINT AND RTEST
; - AUXILIARY FUNCTIONS FOR FORMATTED READ
;
GTSGN: SKIPE FILEOF(REG) ;END-OF-FILE = TRUE
POPJ TOPP , ;YES- RETURN
PUSHJ TOPP ,GETCH ;GETS NEXT COMPONENT
GETSGN: MOVE AC0 ,FILCMP(REG) ;GETS FIRST COMPONENT
CAIN AC0 ," " ;LEADING BLANKS
JRST GTSGN ;YES - OVERREAD THEM
SETZ REG2 , ;FOR INTEGER VALUE
SETZ REG3 , ;FOR SIGN
CAIN AC0 ,"+" ;FIRST COMPONENT EQUAL PLUS ?
JRST .+4 ;YES - GET NEXT COMPONENT
CAIE AC0 ,"-" ;FIRST COMPONENT EQUAL MINUS ?
POPJ TOPP , ;NO - RETURN
MOVEI REG3 ,1 ;YES - SET SIGN BIT
SKIPN FILEOL(REG) ;ENDOFLINE = TRUE ?
PUSHJ TOPP ,GETCH ;NO - GET NEXT COMPONENT
MOVE AC0 ,FILCMP(REG) ;FOR FOLLOWING PARTS TO AC0
POPJ TOPP ,
GETINT: JFCL 10 ,.+1 ;CLAERS FLAGS
GTINT: CAIG AC0 ,"9" ;COMPONENT IN DIGITS ?
CAIGE AC0 ,"0"
POPJ TOPP , ;NO - RETURN
SUBI AC0 ,"0" ;CONVERTS ASCII TO INTEGER
IMULI REG2 ,12 ;OLD INTEGER
ADD REG2 ,AC0 ;ADD NEW ONE
SKIPN FILEOL(REG) ;ENDOFLINE = TRUE ?
PUSHJ TOPP ,GETCH ;NO - GET NEXT COMPONENT
MOVE AC0 ,FILCMP(REG) ;AND GETS IT FOR FOLLOWING PARTS
JRST GTINT ;GET NEXT DIGIT IF ANY
RTEST: CAIG AC0 ,"9" ;CARACTER IN DIGITS ?
CAIGE AC0 ,"0"
JRST CONERR ;NO - WRITE ERROR MESSAGE AND EXIT
POPJ TOPP , ;YES - RETURN
;
;*** LITERALS ***
;
LIT
PRGEND
TITLE SETEOF *** PROCEDURE SETEOF ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY SETEOF
;
;*** EXTERNAL REFERENCES ***
;
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
;
FILDAT= 1 ;FLAG TO TEST FOR TEXT-FILE
FILBIN= 17 ;FLAG TO TEST FOR ASCII-MODE
FILPTR= 0 ;LH= PASCAL FILE FLAGS
;RH= PTR TO COMPONENT
FILEOF= 1
FILEOL= 2
FILOPN= 3
FILLKP= 4
FILENT= 5
FILIN= 6
FILOUT= 7
FILCLS= 10
FILSTA= 11 ;.+0 FOR FILESTATUS
;.+1 FOR DEVICE
;.+2 FOR POINTER TO BUFFERHEADER
FILNAM= 14
FILEXT= 15
FILPRO= 16
FILPPN= 17
FILBFH= 20 ;BUFFER HEADER
FILBTP= 21 ;BYTE POINTER
FILBTC= 22 ;BYTE COUNT IN BUFFER
FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
;CTERS
FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
;R OF WORDS IN COMPONENT
;IF ASCII MODE : CHARACTERCNT IN LIN
;E AND TAB INDICATOR
;RH= ADDRESS OF FIRST WORD IN COMPONE
;NT
FILCMP= 25 ;FIRST WORD OF COMPONENT
;
;*** CONSTANTS ***
;
MAXEOF= 10
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURE SETEOF
; - SET UP EOF-COUNTER
; - SET EOLN, CLEAR CHAR-COUNTER
; - RETURN TO USER
; - <REG>=FILE-BLOCK
;
SETEOF: MOVNI AC0 ,MAXEOF ;INITIALIZE COUNT FOR
;MAXIMUM NUMBER OF ATTEMPTS
MOVEM AC0 ,FILEOF(REG) ;TO READ BEYOND EOF
MOVEI AC0 ," " ;INSERT BLANK
MOVEM AC0 ,FILCMP(REG) ;INTO FILE-COMPONENT
AOS FILEOL(REG) ;SET EOLN = TRUE
HLR AC0 ,FILPTR(REG) ;TEXT-FILE?
TRNN AC0 ,FILDAT ;SKIP IF NOT
HRRZS FILCNT(REG) ;CLEARS CHARACTERCNT
POPJ TOPP , ;RETURN
;
;*** LITERALS
;
LIT
PRGEND
TITLE WRTAUX *** PROCEDURES WRTBLK, TOOSML, WRTSGN AND WRTOPN ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY WRTBLK
ENTRY TOOSML
ENTRY WRTOPN
ENTRY WRTSGN
;
;*** EXTERNAL REFERENCES ***
;
EXTERN PUTCH
;
;*** REGISTER DEFINITION ***
;
AC0= 0
AC1= 1
REGIN= 1 ;INITILISATION OF REGISTERSTACK
REG= REGIN+1
REG1= REGIN+1+1
REG2= REGIN+1+2
REG3= REGIN+1+3
REG4= REGIN+1+4
REG5= REGIN+1+5
REG6= REGIN+1+6
NEWREG= 15
TOPP= 17
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** PROCEDURES WRTBLK, WRTSGN, WRTOPN AND TOOSML
; - AUXLIARY FUNCTIONS FOR FORMATTED WRITE
;
WRTBLK: JUMPLE REG2 ,.+4 ;WRITES BLANKES OUT
MOVEI AC0 ," "
PUSHJ TOPP ,PUTCH
SOJG REG2 ,.-1 ;COUNT EQUAL ZERO?
POPJ TOPP , ;YES - RETURN
WRTOPN: MOVEI REG5 ,(REG2) ;SAVES FORMAT BECAUSE REG2 IS USED FOR
;IDIVI-INSTRUCTION
SETZ REG4 , ;RH - COUNT OF DIGITS ON PUSH-LIST
;LH - EQ 400000 IF SIGN = '-'
JUMPGE REG1 ,OUT ;NEGATIV NUMBER?
TLO REG4 ,400000 ;YES - SET SIGN MARKER
TLNE REG1 ,377777 ;LH = 400000?
JRST OK ;NO - GET MAGNITUDE
TRNN REG1 ,777777 ;RH = 000000?
JRST TOOSM1 ;FOR 400000000000B ONLY OCTAL
OK: SUBI REG5 ,1 ;ONE PLACE IN FORMAT USE FOR SIGN
MOVM REG1 ,REG1
OUT: POPJ TOPP ,
WRTSGN: TLZN REG4 ,400000 ;SIGN EQUAL '-'?
POPJ TOPP , ;NO - RETURN
MOVEI AC0 ,"-" ;YES
JRST PUTCH ;PUTCH RETURNS OVER PUT
TOOSM1: POP TOPP ,AC0 ;DIRECT RETURN TO USER
TOOSML: MOVEI AC0 ,"*" ;FORMAT IS TOO SMALL
PUSHJ TOPP ,PUTCH
SOJG REG5 ,.-1
POPJ TOPP , ;RETURNS OUT OF WRITE-ROUTINE
;
;*** LITERALS
;
LIT
PRGEND
TITLE FORER. *** PROCEDURE FORER. ***
TWOSEG
;
;*** ENTRY-POINTS ***
;
ENTRY FORER.
;
;*** START OF INVARIANT CODE ***
;
RELOC 400000
;
;*** FORTRAN ERROR-EXIT
;
FORER.: OUTSTR [ASCIZ/
%? ERROR IN FORTRAN PROCEDURE/]
EXIT
;
;*** LITERALS ***
;
LIT
PRGEND
title forpassgo
;this file implements the PUTADR, JUMPTO, and LOCATION functions of PASSGO.
comment $ (* the corresponding Pascal data types *)
const dim1 = 8;
dim2 = 20;
dim3 = 64;
type halfword = 0..777777B;
iarr1 = packed array[1..dim1] of halfword;
iarr2 = packed array[1..dim2] of halfword;
iarr3 = packed array[1..dim3] of halfword;
var arr1: iarr1;
arr2: iarr2;
arr3: iarr3;
loc1,adrloc: integer;
procedure putadr(var intarr1: iarr1; (* first array offunctions *)
var intarr2: iarr2; (* second array *)
var intarr3: iarr3); (* third array *)
begin (* putadr *)
. . .
end (* putadr *);
function location (var object: integer) (* variable whose address we need *)
: integer; (* returns addr of OBJECT *)
begin (* location *)
. . .
end (* location *);
procedure jumpto(var where: integer; (* where to jump to *)
stdata: integer); (* start of data area *)
begin (* jumpto *)
. . .
end (* jumpto *);
$ ;end of comment
.request sys:forlib
entry putadr
entry location
entry jumpto
; macro version
p=17
opdef call [pushj p,]
opdef ret [popj p,]
subttl putadr
filnam==0 ;null procedure
adrtb1: getfil##,,getopt##
getsta##,,askfil##
startf##,,getpar##
getnex##,,filnam
reente##,,settim##
timere##,,runtim##
elapse##,,putcha##
assign##,,substr##
concat##,,setran##
adrln1==.-adrtb1
adrtb2: cos##,,exp##
psqrt##,,alog##
atan##,,alog10##
sind##,,cosd##
sinh##,,cosh##
tanh##,,asin##
acos##,,ran##
sin##,,round##
expo##,,option##
0,,trunc##
length##,,getcha##
pos##,,strlt##
strle##,,streq##
strge##,,strgt##
strne##,,0
adrln2==.-adrtb2
adrtb3: corerr##,,srerr##
inxerr##,,overf.##
ipterr##,,seterr##
nocore##,,new##
free##,,end##
runpgm##,,getpar##
resetf##,,rewrit##
ttyopn##,,reset.##
exit.##,,clsfil##
getch##,,get##
getln##,,put##
putln##,,putpg##
putbuf##,,indeb.##
exdeb.##,,debug##
intrea##,,time.##
date.##,,readr##
readi##,,readc##
reads##,,readps##
writec##,,writc1##
wrtust##,,wrtus1##
wrtpst##,,wrtps1##
wrtbol##,,wrtbo1##
wrtrea##,,wrtre1##
wrtre2##,,wrtint##
wrtin1##,,wrthex##
wrthx1##,,wrtoct##
wrtoc1##,,readir##
readcr##,,readrr##
readsc##,,readis##
readcs##,,readds##
wrtsca##,,wrtise##
wrtcse##,,wrtdse##
settim##,,timere##
ptrerr##,,readst##
wrtstr##,,wrtst1##
dpcnts##,,0
adrln3==.-adrtb3
;PUTADR --
;call: 2/ addr(INTARR1)
; 3/ addr(INTARR2)
; 4/ addr(INTARR3)
;return: with intarr1, intarr2, and intarr3 changed
377777
putadr::
hllzm 16,-1(17) ;set up stack frame
hrls 16,p
caig 15,1(p) ;is there room for our temporaries?
call p,corerr
hrri p,1(p)
movei 1,(2) ;get addr(intarr1) [first word thereof]
hrli 1,adrtb1 ; 1 := [adrtb1,,intarr1]
blt 1,adrln1-1(2) ;blt through end of intarr1
movei 1,(3) ;get addr(intarr2)
hrli 1,adrtb2 ; 1 := [adrtb2,,intarr2]
blt 1,adrln2-1(3) ;blt through end of intarr2
movei 1,(4) ;get addr(intarr3)
hrli 1,adrtb3 ; 1 := [adrtb3,,intarr3]
blt 1,adrln3-1(4) ;blt through end of intarr3
hrri p,(16) ;restore the stack
hlrs 16,-1(p)
ret
subttl location
;LOCATION -- function which returns the address of its first argument.
;call: 2/ addr(OBJECT)
;return: +1, of course, with addr(object) on the stack
location::
hllzm 16,-1(p) ;set up stack frame
hrls 16,p
caig 15,1(p) ;is there room for our temporaries?
call p,corerr
hrri p,1(p)
movem 2,1(16) ;return addr(third)
hrri p,(16) ;restore the stack
hlrs 16,-1(p)
ret
subttl jumpto
;JUMPTO -- clean up, and jump to the first argument
;call: 2/ WHERE -- entry point to code area
; 3/ STDATA -- start of data area
; 4/ BUGDAT -- address of debugging data and file descriptor blocks
; to be copied to 140 to 277
; 5/ stktop -- address of the top of the stack.
; 6/ prgnam -- sixbit name of the program.
;return: does not return
377777
jumpto:: ;no need of stack frame, since we aren't
;coming back
setzm (3) ;clear that location to zero
hrls 3
addi 3,1 ; 3 := [stdata,,stdata+1]
hrrz 7,120 ;get addr. of start of file buffers
hrrz 7,(2)
blt 3,-1(7) ;blt to start of file buffers (lose big)
movss 4
hrri 4,140 ;4:=[bugdat,,140]
blt 4,277 ;move the debug data and standard file blocks
hrlm 5,120 ;reset jobsa and jobff
hrrm 2,120
hrrzm 5,121
jrst (2) ;go to WHERE
lit
prgend
end